options validvarname=upcase;
%let domain=adsl;
%include "&studyroot\Work\Programs\macros\template\TDD_formats.sas";

*** get data ;
%get_data(lst=dm ds ex se sv vs,supp=Y,lib=sdtm,pre=sdtm);

 ** informed consent ;
proc sql;
create table consent as select usubjid,min(dsstdtc) as infcdtc
   from sdtmds where index(lowcase(dsdecod),"informed consent")
   group by usubjid;
run;

 ** baseline height, weight, bmi ;
proc sql;
create table htwtbmi as select a.usubjid,b.vsstresn as height,c.vsstresn as weight,d.vsstresn as bmi
   from (select distinct usubjid from sdtmvs) as a
   left join (select distinct usubjid,vsstresn from sdtmvs where lowcase(vstestcd)="height" and visitnum=&vscr) as b
   on a.usubjid=b.usubjid
   left join (select distinct usubjid,vsstresn from sdtmvs where lowcase(vstestcd)="weight" and visitnum=&vscr) as c
   on a.usubjid=c.usubjid
   left join (select distinct usubjid,vsstresn from sdtmvs where lowcase(vstestcd)="bmi" and visitnum=&vscr) as d
   on a.usubjid=d.usubjid
   order by usubjid;
quit;

 ** enrollment ;
/*%macro do_enrollment;*/
/*proc sql;*/
/*select count(distinct usubjid) into :enrl_cnt from sdtmds(where=(index(lowcase(dsterm),"rand")));*/
/*%if &enrl_cnt %then %do;*/
/*create table enrolld as select a.usubjid,dsstdtc as enrldtc,ifn(missing(dsstdtc),0,1) as enrlfn*/
/*   from (select usubjid from sdtmdm) as a*/
/*   left join sdtmds(where=(index(lowcase(dsterm),"rand"))) as b*/
/*   on a.usubjid=b.usubjid*/
/*   order by usubjid;*/
/*%end;*/
/*%else %do;*/
/*create table enrolld as select a.usubjid,dsstdtc as scrfdtc,ifn(missing(dsstdtc),0,1) as scrffn,*/
/*   ifn(missing(dsstdtc),1,0) as enrlfn*/
/*   from (select usubjid from sdtmdm) as a*/
/*   left join sdtmds(where=(index(lowcase(dsterm),"rand"))) as b*/
/*   on a.usubjid=b.usubjid*/
/*   order by usubjid;*/
/*%end;*/
/*quit;*/
/*%mend do_enrollment;*/
/*%do_enrollment;*/

** randomization ;
proc sql;
create table randomz as select a.usubjid,dsstdtc as randdtc,ifn(missing(dsstdtc),0,1) as randfn
   from (select usubjid from sdtmdm) as a
   left join sdtmds(where=(index(lowcase(dsterm),"random"))) as b
   on a.usubjid=b.usubjid
   order by usubjid,randfn, randdtc;
quit;
 
proc transpose data=randomz out=randomzz(drop=_name_ _label_) prefix=rand suffix=dtc ;
	by usubjid randfn;
	var randdtc ;
run;

data randomzz;
set randomzz;
if rand1dtc ne " " then randdtc=strip(rand1dtc);
run;

 
 ** completion ;
proc sql;
create table complet as select a.usubjid,dsstdtc as compdtc,ifn(missing(dsstdtc),0,1) as complfn
   from (select usubjid from sdtmdm) as a
   left join sdtmds as b
   on a.usubjid=b.usubjid
   order by usubjid,compdtc;
quit;

data complett;
set complet;
by usubjid compdtc;
if last.usubjid;
run;

 ** disposition ;
proc sql;
create table discont as select a.usubjid,dsstdtc as discdtc,ifn(missing(dsstdtc),0,1) as discfn,dsdecod,dsterm
   %vchk(in=sdtmds,var=dsaeid,sql=y)
   from (select usubjid from sdtmdm) as a
   left join sdtmds(where=(lowcase(dscat)="disposition event" and lowcase(dsscat)="study completion" and ^index(lowcase(dsdecod),"complet"))) as b
   on a.usubjid=b.usubjid
   order by usubjid;
quit;

** treatment dates ;
*!!!!! Reset treatment temporary !!!!!; 
data sdtmex;
/*length extrt $10.;*/
set sdtmex;
/*if visitnum in (1 2 3) then extrt=strip(extrt)||"A";*/
/*else if visitnum in (4 5 6) then extrt=strip(extrt)||"B";*/

	if EXTRT=:"Very Low Nicotine" then extrt="A";
	else if EXTRT=:"Usual Brand" then extrt="B";
	else if EXTRT=:"Nicorette" then extrt="C";

if visitnum in (4 5 6) then do;
if extrt="A" then extrt="D";
if extrt="B" then extrt="E";
if extrt="C" then extrt="F";
end;
/*if length(exstdtc)>16 then exstdtc=strip(substr(exstdtc,1,16));*/
/*else exstdtc=strip(exstdtc);*/
/*if length(exendtc)>16 then exendtc=strip(substr(exendtc,1,16));*/
/*else exendtc=strip(exendtc);*/
if length(exstdtc)=16 then exstdtc=strip(exstdtc)||":00";
else exstdtc=strip(exstdtc);
if length(exendtc)=16 then exendtc=strip(exendtc)||":00";
else exendtc=strip(exendtc);
if length(exstdtc)=10 or length(exendtc)=10 then delete;
run;

proc sql;
create table xfldosdt as select usubjid,min(exstdtc) as fdosdtc,max(exendtc) as ldosdtc
   from sdtmex group by usubjid;
create table ex_by_trt0 as select usubjid,extrt,min(exstdtc) as exstdtc,max(exendtc) as exendtc
   from sdtmex group by usubjid,extrt;
/*create table trt_fmt0 as select distinct upcase("trt_fmt") as fmtname,extrt as start from ex_by_trt0;*/
create table trt_fmt0 as select distinct upcase("trt_fmt") as fmtname,extrt as start from ex_by_trt0;
create table trt_fmt as select *,monotonic() as label from trt_fmt0;
quit;

%mk_fmt(fmtnam=trt_fmt,start=start,label=label,in=trt_fmt/*,fmtlib=fmtsdtm*/);

proc sort data=ex_by_trt0; 
  by usubjid exstdtc; 
run;

data ex_by_trt;
   set ex_by_trt0;
   by usubjid exstdtc;
   retain ord;
   if first.usubjid then ord=1;
   else ord=ord+1;
run;

proc sql;
create table count as select usubjid,count(ord) as cnt from ex_by_trt group by usubjid;
create table xtrdosdt as select a.usubjid,a.extrt,strip(put(a.ord,z2.)) as trn,
   a.exstdtc,b.cnt,a.exendtc as exendtc
   from ex_by_trt as a left join count as b on a.usubjid=b.usubjid
   left join ex_by_trt as c on a.usubjid=c.usubjid and a.ord=c.ord-1;
select count(distinct trn) into :trn_cnt from xtrdosdt;
select distinct trn into :trn_lst separated by " " from xtrdosdt;
quit;

proc transpose data=xtrdosdt prefix=tr suffix=sdtc out=xtrdstdt(drop=_name_);
   var exstdtc;
   id trn;
   by usubjid;
run;

proc transpose data=xtrdosdt prefix=tr suffix=edtc out=xtrdendt(drop=_name_);
   var exendtc;
   id trn;
   by usubjid;
run;

 ** pk flags ;
proc sql;
create table pkpop as select a.usubjid,a.subjid, ifn(pkfnn,1,0) as pkfn from sdtmdm as a
   left join (select distinct subjectid,pkuse_coded as pkfnn from rawdata.pk) as b
   on a.subjid=b.subjectid
   order by usubjid;
run;

*Last dose medication;

proc sql;
create table ldmed as select a.usubjid,DSDTCMED from (select usubjid from sdtmdm) as a
   left join sdtmds as b
   on a.usubjid=b.usubjid where DSDTCMED ne " " 
   order by usubjid;
quit;

proc sql;
create table dscom as select distinct usubjid,coval as dscom from sdtmds where ^missing(coval);
quit;
/*proc sort data=discont nodupkey out=discont; by _all_; run; */
/*proc sort data=discont; by usubjid; run; */

*** gather data ;
data info;
length _armcd _actarmcd $40.;
   merge sdtmdm htwtbmi  randomzz complett discont xfldosdt xtrdstdt xtrdendt pkpop ldmed dscom;
   by usubjid;
if index(armcd,"/")>0 then do;
if index(armcd,"/BCA") then _armcd=tranwrd(armcd,"/BCA","EFD");
if index(armcd,"/ABC") then _armcd=tranwrd(armcd,"/ABC","DEF");
if index(armcd,"/CAB") then _armcd=tranwrd(armcd,"/CAB","FDE");
end;
/*actarmcd=strip(armcd);*/
if index(actarmcd,"/")>0 then do;
if index(actarmcd,"/BCA") then _actarmcd=tranwrd(actarmcd,"/BCA","EFD");
if index(actarmcd,"/ABC") then _actarmcd=tranwrd(actarmcd,"/ABC","DEF");
if index(actarmcd,"/CAB") then _actarmcd=tranwrd(actarmcd,"/CAB","FDE");

if index(actarmcd,"/BC") and length(actarmcd)=6 then _actarmcd=tranwrd(actarmcd,"/BC","EF");
if index(actarmcd,"/B") and length(actarmcd)=5 then _actarmcd=tranwrd(actarmcd,"/B","E");

if index(actarmcd,"/AB") and length(actarmcd)=6 then _actarmcd=tranwrd(armcd,"/AB","DE");
if index(actarmcd,"/A") and length(actarmcd)=5 then _actarmcd=tranwrd(armcd,"/A","D");

if index(actarmcd,"/CA") and length(actarmcd)=6 then _actarmcd=tranwrd(armcd,"/CA","FD");
if index(actarmcd,"/C") and length(actarmcd)=5 then _actarmcd=tranwrd(armcd,"/C","F");
end;
if index(armcd,"/")=0 then do;
_armcd=strip(armcd);
end;
if index(actarmcd,"/")=0 then do;
_actarmcd=strip(actarmcd);
end;
run;

*** build adam ;
proc format;
value _0n1y
    0="N"
    1="Y"
     ;
run;

%macro do_treatments;
   %let dt_i=1;
   %do %while(%scan(&trn_lst,&dt_i,%str( ))^= );
      %let itm=%scan(&trn_lst,&dt_i,%str( ));
/*      format tr&itm.sdt tr&itm.edt date9. tr&itm.stm tr&itm.etm time5. tr&itm.sdtm tr&itm.edtm datetime13.;*/
	        format tr&itm.sdt tr&itm.edt date9. tr&itm.stm tr&itm.etm time8. tr&itm.sdtm tr&itm.edtm datetime18.;

      if ^missing(%rmtime(tr&itm.sdtc)) then tr&itm.sdt=input(%rmtime(tr&itm.sdtc),is8601da.);
      if ^missing(%kptime(tr&itm.sdtc)) then tr&itm.stm=input(%kptime(tr&itm.sdtc),is8601tm.);
      if nmiss(tr&itm.sdt,tr&itm.stm)=0 then tr&itm.sdtm=input(%rmtime(tr&itm.sdtc)||"%uc(t)"||%kptime(tr&itm.sdtc),is8601dt.);
      if ^missing(%rmtime(tr&itm.edtc)) then tr&itm.edt=input(%rmtime(tr&itm.edtc),is8601da.);
      if ^missing(%kptime(tr&itm.edtc)) then tr&itm.etm=input(%kptime(tr&itm.edtc),is8601tm.);
      if nmiss(tr&itm.edt,tr&itm.etm)=0 then tr&itm.edtm=input(%rmtime(tr&itm.edtc)||"%uc(t)"||%kptime(tr&itm.edtc),is8601dt.);

	  if ^missing(tr&itm.sdtc) then do;
         length trt&itm.p trt&itm.a $100.;
/*         trt&itm.p=strip(scan(arm,&dt_i,"/"));*/
         trt&itm.p=strip(_armcd);
         trt&itm.pn=input(substr(_armcd,&dt_i,1),trt_fmt.);
/*         trt&itm.a=strip(scan(actarm,&dt_i,"/"));*/
         trt&itm.a=strip(_actarmcd);
         trt&itm.an=input(substr(_actarmcd,&dt_i,1),trt_fmt.);
      end;
     
      %let dt_i=%eval(&dt_i+1);
   %end;
%mend do_treatments;

data tolbl;
   set info;
   length lsubjid sexc $12. dispdtc $40. fasfl saffl ittfl pprotfl pkfl complfl randfl $1. reasexcl reaspop status $200.;

   *** combined identifier for listings ;
   lsubjid=upcase(catx("/",subjid,put(age,2.0),sex));

   *** numerical demog ;
   aage=age;
   if ^missing(sex) then do;
      sexn=input(sex,fsexn.);
      sexc=put(sex,$fsex.);
   end;
   if ^missing(race) then racen=input(race,fracen.);
   if ^missing(ethnic) then ethnicn=input(ethnic,fethn.);

   *** randomization ;
/*   randano=strip(RANDNUMA);*/
/*   randbno=strip(RANDNUMB);*/
      randano=strip(randano);
   randbno=strip(randbno);


   format rand1dt rand2dt randdt date9.;
   if ^missing(%rmtime(randdtc)) then randdt=input(%rmtime(randdtc),is8601da.);
   if ^missing(%rmtime(rand1dtc)) then rand1dt=input(%rmtime(rand1dtc),is8601da.);
   if ^missing(%rmtime(rand2dtc)) then rand2dt=input(%rmtime(rand2dtc),is8601da.);

   *** status flags ;
   enrlfn=randfn;
   enrlfl=strip(put(enrlfn,_0n1y.));
   randfl=strip(put(randfn,_0n1y.));
   discfl=strip(put(discfn,_0n1y.));

   if DISCDTC ne " " then complfn=0;
   else complfn=1;
      complfl=strip(put(complfn,_0n1y.));

   *** treatment ;
   if ^missing(%rmtime(fdosdtc)) then trtsdt=input(%rmtime(fdosdtc),is8601da.);
   if ^missing(%kptime(fdosdtc)) then trtstm=input(%kptime(fdosdtc),is8601tm.);
   if nmiss(trtsdt,trtstm)=0 then trtsdtm=input(%rmtime(fdosdtc)||"%uc(t)"||%kptime(fdosdtc),is8601dt.);
   if ^missing(%rmtime(ldosdtc)) then trtedt=input(%rmtime(ldosdtc),is8601da.);
   if ^missing(%kptime(ldosdtc)) then trtetm=input(%kptime(ldosdtc),is8601tm.);
   if nmiss(trtedt,trtetm)=0 then trtedtm=input(%rmtime(ldosdtc)||"%uc(t)"||%kptime(ldosdtc),is8601dt.);
   %do_treatments;

/*   TRT01P="Planned Treatment for Period 01"*/
/*   TRT01PN="Planned Treatment for Period 01 (N)"*/
/*   TRT01A="Actual Treatment for Period 01"*/
/*   TRT01AN="Actual Treatment for Period 01 (N)"*/

   *** population flags ;
    ** fasfl ;
   if fasfl=" " then fasfl=" ";
   if fasfn=. then fasfn=.;
    ** saffl ;
/*   if n(randdt,trtsdt)=2 and length(_actarmcd) ge 3 then do; saffl=upcase("y"); saffn=1; end;*/
      if n(randdt,trtsdt)=2 and length(_actarmcd) ge 1 then do; saffl=upcase("y"); saffn=1; end;

   else do; saffl=upcase("n"); saffn=0; end; 
    ** ittfl ;
   if ittfl=" " then ittfl=" ";
   if ittfn=. then ittfn=.;
    ** pprotfl ;
   if pprotfl=" " then pprotfl=" ";
   if pprotfn=. then pprotfn=.;

   ** pkfl ;
   *!!!!!!!!!!!!!!!!!!!!! Set to Y for testing !!!!!!!!!!!!!!!!!!!!!;
   pkfn=1;
   pkfl=strip(put(pkfn,_0n1y.));

/*   pkfl=strip(put(pkfn,_0n1y.));*/
/*   pkfl="Y";*/

   *** disposition ;
   dispdtc=coalescec(compdtc,discdtc);
   format dispdt date9.;
   if ^missing(%rmtime(dispdtc)) then dispdt=input(%rmtime(dispdtc),is8601da.);

   if ^missing(dsdecod) then reasexcl=strip(dsterm);
   if ^missing(dsdecod) then status=strip(dsdecod);
   else if complfn then status=upcase("completed");

/*   if dsdecod ne dsterm then status=strip(dsterm);*/
/*   	else status=strip(status);*/

   if lowcase(randfl)="n" then reaspop=propcase("Not Randomized");
   else if lowcase(ittfl)="n" then reaspop=" ";
   else if lowcase(saffl)="n" then reaspop="%upcase(S)ubject did not take any %upcase(T)reatment";
   else if lowcase(pprotfl)="n" then reaspop=" ";
   else if lowcase(pkfl)="n" then reaspop=" ";
run;


*Rederive PKFL based on QNAM=PKPOP from SUPPPC and SUPPPP;

proc sql ;
create table pcflag as select distinct usubjid, qval as pkpop1 from sdtm.supppp where qnam="PKPOP" and qval="Y" order by usubjid;
create table ppflag as select distinct usubjid, qval as pkpop2 from sdtm.supppc where qnam="PKPOP" and qval="Y" order by usubjid;
quit;

data tolbl;
length pkfl $1. reaspop $200. pkfn 8.;
merge tolbl(in=main) pcflag ppflag;
by usubjid;
if main;
/*if pkpop1="Y" and pkpop2="Y" then pkfn=1;*/
if pkpop1="Y" or pkpop2="Y" then pkfn=1;

else pkfn=0;
pkfl=strip(put(pkfn,_0n1y.));
   if lowcase(randfl)="n" then reaspop=propcase("Not Randomized");
   else if lowcase(ittfl)="n" then reaspop=" ";
   else if lowcase(saffl)="n" then reaspop="%upcase(S)ubject did not take any %upcase(T)reatment";
   else if lowcase(pprotfl)="n" then reaspop=" ";
   else if lowcase(pkfl)="n" then reaspop=" ";
run;

**Set single treatment (to fix macro ) and Returm real value back for treatment Part 2;

data tolbla;
set tolbl;
if trt01p ne " " then do; trt01p=strip(substr(trt01p,1,1)); end;
if trt02p ne " " then do; trt02p=strip(substr(trt02p,2,1)); end;
if trt03p ne " " then do; trt03p=strip(substr(trt03p,3,1)); end;
if trt04p ne " " then do; 
if length(trt04p) ge 4 then trt04p=strip(substr(trt04p,4,1)); 
else trt04p=" ";
end;
if trt05p ne " " then do; 
if length(trt05p) ge 5 then trt05p=strip(substr(trt05p,5,1)); 
else trt05p=" ";
end;
if trt06p ne " " then do; 
if length(trt06p) ge 6 then trt06p=strip(substr(trt06p,6,1)); 
else trt06p=" ";
end;

if trt01a ne " " then do; trt01a=strip(substr(trt01a,1,1)); end;
if trt02a ne " " then do; trt02a=strip(substr(trt02a,2,1)); end;
if trt03a ne " " then do; trt03a=strip(substr(trt03a,3,1)); end;
if trt04a ne " " then do; 
if length(trt04a) ge 4 then trt04a=strip(substr(trt04a,4,1)); 
else trt04a=" ";
end;
if trt05a ne " " then do; 
if length(trt05a) ge 5 then trt05a=strip(substr(trt05a,5,1)); 
else trt05a=" ";
end;
if trt06a ne " " then do; 
if length(trt06a) ge 6 then trt06a=strip(substr(trt06a,6,1)); 
else trt06a=" ";
end;

trt04a=tranwrd(trt04a,"D","A");
trt04a=tranwrd(trt04a,"E","B");
trt04a=tranwrd(trt04a,"F","C");

trt05a=tranwrd(trt05a,"D","A");
trt05a=tranwrd(trt05a,"E","B");
trt05a=tranwrd(trt05a,"F","C");

trt06a=tranwrd(trt06a,"D","A");
trt06a=tranwrd(trt06a,"E","B");
trt06a=tranwrd(trt06a,"F","C");

trt04p=tranwrd(trt04p,"D","A");
trt04p=tranwrd(trt04p,"E","B");
trt04p=tranwrd(trt04p,"F","C");

trt05p=tranwrd(trt05p,"D","A");
trt05p=tranwrd(trt05p,"E","B");
trt05p=tranwrd(trt05p,"F","C");

trt06p=tranwrd(trt06p,"D","A");
trt06p=tranwrd(trt06p,"E","B");
trt06p=tranwrd(trt06p,"F","C");

/*randano=randnuma;*/
/*randbno=randnumb;*/
run;



data final;
  set tolbla;
  label
   AGEU="Age Units"
   FASFL="Full Analysis Set Population Flag"
   FASFN="Full Analysis Set Population Flag (N)"
   SAFFL="Safety Population Flag"
   SAFFN="Safety Population Flag (N)"
   ITTFL="Intent-To-Treat Population Flag"
   ITTFN="Intent-To-Treat Population Flag (N)"
   PPROTFL="Per-Protocol Population Flag"
   PPROTFN="Per-Protocol Population Flag (N)"
   COMPLFL="Completers Population Flag"
   COMPLFN="Completers Population Flag (N)"
   RANDFL="Randomized Population Flag"
   RANDFN="Randomized Population Flag (N)"

	       RANDAFL="Randomized Population Flag in part A"
		   RANDAFN="Randomized Population Flag in part A (N)"
		   RANDBFL="Randomized Population Flag in part B"
		   RANDBFN="Randomized Population Flag in part B (N)"

   ENRLFL="Enrolled Population Flag"
   ENRLFN="Enrolled Population Flag (N)"

   TRT01P="Planned Treatment for Period 01"
   TRT01PN="Planned Treatment for Period 01 (N)"
   TRT01A="Actual Treatment for Period 01"
   TRT01AN="Actual Treatment for Period 01 (N)"
   	   	TRT02P="Planned Treatment for Period 02"
  		TRT02PN="Planned Treatment for Period 02 (N)"
   		TRT02A="Actual Treatment for Period 02"
	   	TRT02AN="Actual Treatment for Period 02 (N)"
	   	   	TRT03P="Planned Treatment for Period 03"
	  		TRT03PN="Planned Treatment for Period 03 (N)"
	   		TRT03A="Actual Treatment for Period 03"
   			TRT03AN="Actual Treatment for Period 03 (N)"
   	   	TRT04P="Planned Treatment for Period 04"
  		TRT04PN="Planned Treatment for Period 04 (N)"
   		TRT04A="Actual Treatment for Period 04"
   		TRT04AN="Actual Treatment for Period 04 (N)"
	   	   	TRT05P="Planned Treatment for Period 05"
	  		TRT05PN="Planned Treatment for Period 05 (N)"
	   		TRT05A="Actual Treatment for Period 05"
	   		TRT05AN="Actual Treatment for Period 05 (N)"
   	   	TRT06P="Planned Treatment for Period 06"
  		TRT06PN="Planned Treatment for Period 06 (N)"
   		TRT06A="Actual Treatment for Period 06"
   		TRT06AN="Actual Treatment for Period 06 (N)"

   RANDDT="Date of Randomization"
      	RANDADT="Date of Randomization in Part A"
   		RANDBDT="Date of Randomization in Part B"

   TRTSDT="Date of First Exposure to Treatment"
   TRTSTM="Time of First Exposure to Treatment"
   TRTSDTM="Datetime of First Exposure to Treatment"
   TRTEDT="Date of Last Exposure to Treatment"
   TRTETM="Time of Last Exposure to Treatment"
   TRTEDTM="Datetime of Last Exposure to Treatment"
	   TR01SDT="Date of First Exposure in Period 01"
	   TR01STM="Time of First Exposure in Period 01"
	   TR01SDTM="Datetime of First Exposure in Period 01"
	   TR01EDT="Date of Last Exposure in Period 01"
	   TR01ETM="Time of Last Exposure in Period 01"
	   TR01EDTM="Datetime of Last Exposure in Period 01"

   TR02SDT="Date of First Exposure in Period 02"
   TR02STM="Time of First Exposure in Period 02"
   TR02SDTM="Datetime of First Exposure in Period 02"
   TR02EDT="Date of Last Exposure in Period 02"
   TR02ETM="Time of Last Exposure in Period 02"
   TR02EDTM="Datetime of Last Exposure in Period 02"

   TR03SDT="Date of First Exposure in Period 03"
   TR03STM="Time of First Exposure in Period 03"
   TR03SDTM="Datetime of First Exposure in Period 03"
   TR03EDT="Date of Last Exposure in Period 03"
   TR03ETM="Time of Last Exposure in Period 03"
   TR03EDTM="Datetime of Last Exposure in Period 03"

   TR04SDT="Date of First Exposure in Period 04"
   TR04STM="Time of First Exposure in Period 04"
   TR04SDTM="Datetime of First Exposure in Period 04"
   TR04EDT="Date of Last Exposure in Period 04"
   TR04ETM="Time of Last Exposure in Period 04"
   TR04EDTM="Datetime of Last Exposure in Period 04"

   TR05SDT="Date of First Exposure in Period 05"
   TR05STM="Time of First Exposure in Period 05"
   TR05SDTM="Datetime of First Exposure in Period 05"
   TR05EDT="Date of Last Exposure in Period 05"
   TR05ETM="Time of Last Exposure in Period 05"
   TR05EDTM="Datetime of Last Exposure in Period 05"

   TR06SDT="Date of First Exposure in Period 06"
   TR06STM="Time of First Exposure in Period 06"
   TR06SDTM="Datetime of First Exposure in Period 06"
   TR06EDT="Date of Last Exposure in Period 06"
   TR06ETM="Time of Last Exposure in Period 06"
   TR06EDTM="Datetime of Last Exposure in Period 06"

   LSUBJID="Subject Identifier, Age, Sex, and Race"
   		RANDANO="Randomization Number in Part A"
      	RANDBNO="Randomization Number in Part B"

   SEXN="Sex (N)"
/*   SEXC="Sex"*/
   RACEN="Race (N)"
   ETHNICN="Ethnicity (N)"
   HEIGHT="Height at Baseline"
   WEIGHT="Weight at Baseline"
   BMI="BMI at Baseline"
   PKFL="Pharmacokinetic Population Flag"
   PKFN="Pharmacokinetic Population Flag (N)"
      	PDFL="PD Population Flag"
   		PDFN="PD Population Flag (N)"

   REASEXCL="Reason for Discontinuation"
   REASPOP="Reason for Exclusion"
   STATUS="Patient Status at End of Study"
   DISPDTC="Completion Date"
   DSDTCMED="Last Dose of Study Medication"
   ;
/*   format trtsdt trtedt date9. trtstm trtetm time5. trtsdtm trtedtm datetime13.;*/
      format trtsdt trtedt RANDADT RANDBDT date9. trtstm trtetm time8. trtsdtm trtedtm datetime18.;
pdfl=pkfl;
pdfn=pkfn;

/* RAND1DT as RANDADT and RAND2DT as RANDBDT */
RANDADT=RAND1DT;
RANDBDT=RAND2DT;

/*RANDAFL, RANDAFN, RANDBFL and RANDBFN*/

randafn=randfn;
if RANDBDT ne . and length (_armcd /*_actarmcd*/) ge 3 then RANDBFN=1; else RANDBFN=0; 
   randafl=strip(put(randafn,_0n1y.));
   randbfl=strip(put(randbfn,_0n1y.));

run;

*Derive PDFL;
/**/
/*1/ at least one product taken in controlled use (EXCAT=Controlled) of part B (EXGRPID=PART B*/
/*2/ pre-use (QSTPT missing [note: shouldn't it be PRE_DOSE??]) TNW questionnaire (QSCAT=Tobacco/Nicotine Withdrawal) in controlled use (QSSCAT=1st Use) part B */
/*3/ post-use (QSTPT > 0) TNW questionnaire and direct effect questionnaire (QSCAT=Tobacco/Nicotine Withdrawal and QSCAT=Direct Effects of Product)*/
/*	in controlled use (QSSCAT=1st Use) part B*/

proc sort data=sdtmex out=expd(keep=usubjid excat exgrpid);
by usubjid;
where excat=:"Controlled" and exgrpid="PART B";
run;

data expd(keep=usubjid pd0); set expd; by usubjid; if first.usubjid; pd0="Y"; run;

proc sort data=sdtm.qs out=qspd1(keep=usubjid qscat qsscat qstpt qstptnum visitnum);
by usubjid qsdtc visitnum;
where visitnum ge 3 and qstpt=" " and qstptnum=. and upcase(qscat)="TOBACCO/NICOTINE WITHDRAWAL" and qsscat="1st Use";
run;

data qspd1(keep=usubjid pd1); set qspd1; by usubjid; if first.usubjid; pd1="Y"; run;

proc sort data=sdtm.qs out=qspd2(keep=usubjid qscat qsscat qstpt qstptnum visitnum);
by usubjid qsdtc visitnum;
where visitnum ge 3 and qstpt ne " " and qstptnum>0 and (upcase(qscat)="TOBACCO/NICOTINE WITHDRAWAL" or upcase(qscat)="DIRECT EFFECTS OF PRODUCT") and qsscat="1st Use";
run;

data qspd2(keep=usubjid pd2); set qspd2; by usubjid; if first.usubjid; pd2="Y"; run;

data final;
merge final(in=main) expd qspd1 qspd2;
by usubjid;
if main;
pdfl=" "; pdfn=.;
if pd0="Y" and pd1="Y" and pd2="Y" then pdfl="Y"; else pdfl="N";
if pdfl="Y" then pdfn=1; else pdfn=0;

*!!!!!!!!!! Set PDFL="Y" temporary until QS be updated for EMAX## tests !!!!!!!!!!;
/*pdfl="Y";  pdfn=1;*/
run;

%macro make_var_lst(name);
%global &name._lst;
%let &name._lst=;
Proc sql noprint;
create table grp_l as select name
   from dictionary.columns
   where lowcase(libname)="work" and lowcase(memname)="final" and index(lowcase(name),"&name")
   and substr(lowcase(reverse(strip(name))),1,1)^="n"
   ;
create table grp_n as select name
   from dictionary.columns
   where lowcase(libname)="work" and lowcase(memname)="final" and index(lowcase(name),"&name")
   and substr(lowcase(reverse(strip(name))),1,1)="n"
   ;
create table grp as select catx(",",l.name,n.name) as &name._lst
   from grp_l as l
   left join grp_n as n
   on index(upcase(l.name),upcase(substr(n.name,1,length(n.name)-1)))
   order by l.name;
select catx(",",l.name,n.name) into :&name._lst separated by ","
   from grp_l as l
   left join grp_n as n
   on index(upcase(l.name),upcase(substr(n.name,1,length(n.name)-1)))
   order by l.name;
quit;
%clrw(grp_l grp_n grp);
%if 0<%length(&name._lst) %then %let &name._lst=,&&&name._lst;
%put ****(&name._lst=&&&name._lst)****;
%mend make_var_lst;

%make_var_lst(fasf); %make_var_lst(saff); %make_var_lst(ittf); %make_var_lst(pprotf);
%make_var_lst(trt0);

proc sql;
create table adamw.adsl(label="subject-level analysis" sortedby=studyid usubjid) as
   select studyid,usubjid,subjid,siteid,age,ageu,brthdtc,sex,sexn,race,racen,ethnic,ethnicn,
   		enrlfl,enrlfn 
   &saff_lst, 
/*randfl,randfn,*/
randafl,randafn,randbfl,randbfn,complfl,complfn,
		pkfl,pkfn,pdfl,pdfn,
   armcd,arm,actarmcd, actarm,
trt01p,trt01pn,trt01a,trt01an,
   trt02p,trt02pn,trt02a,trt02an,
trt03p,trt03pn,trt03a,trt03an,
	trt04p,trt04pn,trt04a,trt04an,
trt05p,trt05pn,trt05a,trt05an,
trt06p,trt06pn,trt06a,trt06an,
/*   randdt,*/
randadt,randbdt,
trtsdt,trtstm,trtsdtm,trtedt,trtetm,trtedtm,
tr01sdt,tr01stm,tr01sdtm,tr01edt,tr01etm,tr01edtm,
	tr02sdt,tr02stm,tr02sdtm,tr02edt,tr02etm,tr02edtm,
tr03sdt,tr03stm,tr03sdtm,tr03edt,tr03etm,tr03edtm,
	tr04sdt,tr04stm,tr04sdtm,tr04edt,tr04etm,tr04edtm,
tr05sdt,tr05stm,tr05sdtm,tr05edt,tr05etm,tr05edtm,
	tr06sdt,tr06stm,tr06sdtm,tr06edt,tr06etm,tr06edtm,
/*   lsubjid,*/
country,
randano,randbno,
/*sexn,racen,ethnic,ethnicn,*/
height,weight,bmi,reasexcl,dscom,
/*reaspop,*/
status,
   dthdtc,dispdtc %vchk(final,dsaeid,sql=y),DSDTCMED 
   from final
   order studyid, usubjid
   ;
quit;

proc contents data=adamw.adsl; run;

%clrw;